Gigarom 4/Mac Giga-ROM 4.0 - 1993.toast/FILES/DEV/I-Z/ViewIt™ Shareware.sea/ViewIt™ 2.04 Shareware/Projects/Fortran Demos/vDemoLF.f

Text File | 1992-08-04 | 5KB | 144 lines

C NOTE: Read the "MPW Fortrans" section of "About Compilers"
C before compiling LF programs that use FaceWare modules.

C ViewIt 2.03 Demonstration Program
C ©FaceWare 1991-92.  All Rights Reserved.

!!M Inlines.f
!!I FaceProcLF.inc

      PROGRAM vDemoLF
    implicit none
C NOTE: If you use the "!!G" directive for precompiled globals, add
C our FaceStorLF.inc globals to yours and then remove following line
    include 'FaceStorLF.inc'
      record /FaceRec/ fRec
      common/FaceStuff/fRec
    logical*4 helpShown
    integer*4 myPtr
    structure /DataRec/
      integer*2 myInteger
      real*4 myReal
      character*100 myString
      integer*4 myFlags
    end structure
    record /DataRec/ myRec
    common /MyStuff/ myRec
    real*4 theReal

    myRec.myInteger = 0
    myRec.myReal = 6.2
    myRec.myString = 'Hello'
    myRec.myFlags = 10
    theReal = 6.0

C Initialize FaceIt
      fRec.uName = 'vDemo.Rsrc'
      call FaceIt(0,DoInit,0,0,0,0)

C Show ViewIt On-Line Help (if available)
    call FaceIt(0,HlpWnd,0,0,10,10)

C Open Modeless Window using FWND 1000
    call FaceIt(0,NewWnd,1000,1,0,0)

      do while (.true.)
        call FaceIt(0,DoLoop,0,0,0,0)
C Standard "About" Menu Item Selection
      if ((fRec.uMenuID = 101).and.(fRec.uMenuItem = 1)) then
        fRec.uString = 'Demonstration of the use of ViewIt'
     +//char(13)//'windows in a FaceIt-based program.'
        call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
C Hit in Modeless Window's "Open Modal" Button
      else if ((fRec.uMenuID = 1000).and.(fRec.wcHit = 2)) then
        call FaceIt(0,NewWnd,1001,0,0,0)  !Open Modal Window
        do while (.true.)
          call FaceIt(0,MdlWnd,1001,0,0,0)  !Process Modal Events
        if (fRec.wcHit = -1) then        !Hit in Close Box
          exit
        else if (fRec.wcHit = 1) then     !Hit in "Open Nested"
          myPtr = %loc(myRec)
          call FaceIt(0,NewWnd,1002,0,0,myPtr)!Open Nested Modal
          call FaceIt(0,GetCtl,1002,0,2,3)      !Setup Override Examples
          call FaceIt(0,OvrCtl,fRec.cControl,%loc(OverProc),0,0)
          call FaceIt(0,GetCtl,1002,0,2,6)
          call FaceIt(0,OvrCtl,fRec.cControl,%loc(OverProc),0,0)
          call FaceIt(0,GetCtl,1002,0,2,7)
          call FaceIt(0,OvrCtl,fRec.cControl,%loc(OverProc),0,0)
          call FaceIt(0,SetVal,1002,0,0,0)      !Set Linked Values
          helpShown = .false.
          do while (.true.)
            call FaceIt(0,MdlWnd,1002,0,0,0)  !Process Modal Events
            if (fRec.wvHit = 1) then          !Hit in View #1
              if (fRec.wcHit = 1) then      !Hit in "OK" Button
              exit
            else if (fRec.wcHit = 2) then   !Hit in "Show/Hide"
              if (helpShown) then
                call FaceIt(0,ShoCtl,0,0,-3,2)  !Hide v3, Show v2
                helpShown = .false.
              else
                call FaceIt(0,ShoCtl,0,0,-2,3)  !Hide v2, Show v3
                helpShown = .true.
              end if
            end if
            end if
          end do
          call FaceIt(0,GetVal,1002,0,0,0)      !Get Linked Values
          call FaceIt(0,EndWnd,1002,0,0,0)      !Close Nested Modal
        end if
        end do
        call FaceIt(0,EndWnd,1001,0,0,0)  !Close Modal Window
C Hit in Modeless Window's "Why ViewIt?" Button
      else if ((fRec.uMenuID = 1000).and.(fRec.wcHit = 3)) then
        call FaceIt(0,NewWnd,1003,0,0,%loc(theReal))
        call FaceIt(0,SetVal,1003,0,0,0)
        do while (.true.)
          call FaceIt(0,MdlWnd,1003,0,0,0)
        if (fRec.wcHit = 1) exit
        end do
        call FaceIt(0,GetVal,1003,0,0,0)
        call FaceIt(0,EndWnd,1003,0,0,0)
      end if
    end do
    end

    SUBROUTINE OverProc(%val(thePtr))
    implicit none
C NOTE: If you use the "!!G" directive for precompiled globals, add
C our FaceStorLF.inc globals to yours and then remove following line
    include 'FaceStorLF.inc'
      record /FaceRec/ fRec
      common/FaceStuff/fRec
    structure /DataRec/
      integer*2 myInteger
      real*4 myReal
      character*100 myString
      integer*4 myFlags
    end structure
    record /DataRec/ myRec
    common /MyStuff/ myRec
    integer*4 thePtr,theArrow
    real*4 delta
    if (fRec.cResID = 1000) then      !Arrow Controls
      if (fRec.uCommand = 8) then        !mouse down message?
        delta = 0.001 * (fRec.cMin - 2)
        theArrow = fRec.cControl
        call HiliteControl(%val(theArrow),%val(int2(1)))
        do while (StillDown())
          myRec.myReal = myRec.myReal + delta
        call FaceIt(0,SetVal,0,0,2,2)
        call Delay(%val(5),fRec.uI4)
        end do
        call HiliteControl(%val(theArrow),%val(int2(0)))
        return
      end if
    else                        !Editable Text Item
      if (fRec.uCommand = 264) then    !a key down message?
        if (fRec.uParam(1) = 32) then    !SPACE key pressed?
          fRec.uParam(1) = 95        !convert to UNDERLINE
        end if
      end if
    end if
    call fJumpIt(%val(long(thePtr)),thePtr) !pass message to driver
    end